home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / lib / sigscheme-init.scm next >
Encoding:
Text File  |  2010-11-07  |  4.1 KB  |  118 lines
  1. ;;  Filename : sigscheme-init.scm
  2. ;;  About    : Initialization file for SigScheme
  3. ;;
  4. ;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
  5. ;;
  6. ;;  All rights reserved.
  7. ;;
  8. ;;  Redistribution and use in source and binary forms, with or without
  9. ;;  modification, are permitted provided that the following conditions
  10. ;;  are met:
  11. ;;
  12. ;;  1. Redistributions of source code must retain the above copyright
  13. ;;     notice, this list of conditions and the following disclaimer.
  14. ;;  2. Redistributions in binary form must reproduce the above copyright
  15. ;;     notice, this list of conditions and the following disclaimer in the
  16. ;;     documentation and/or other materials provided with the distribution.
  17. ;;  3. Neither the name of authors nor the names of its contributors
  18. ;;     may be used to endorse or promote products derived from this software
  19. ;;     without specific prior written permission.
  20. ;;
  21. ;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
  22. ;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  23. ;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  24. ;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
  25. ;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  26. ;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  27. ;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  28. ;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  29. ;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  30. ;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  31. ;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32.  
  33.  
  34. (define %with-guarded-char-codec
  35.   (lambda (thunk)
  36.     (let ((orig-codec (%%current-char-codec))
  37.           (thunk-codec (%%current-char-codec)))
  38.       (dynamic-wind
  39.           (lambda ()
  40.             (%%set-current-char-codec! thunk-codec))
  41.           thunk
  42.           (lambda ()
  43.             (set! thunk-codec (%%current-char-codec))
  44.             (%%set-current-char-codec! orig-codec))))))
  45.  
  46. (define with-char-codec
  47.   (lambda (codec thunk)
  48.     (%with-guarded-char-codec
  49.      (lambda ()
  50.        (%%set-current-char-codec! codec)
  51.        (thunk)))))
  52.  
  53. ;; Preserve original C implementation.
  54. (define %%load load)
  55.  
  56. ;; Recover original char codec when an error is occurred on loading.
  57. (define load
  58.   (if (provided? "multibyte-char")
  59.       (lambda (file)
  60.         (%with-guarded-char-codec
  61.          (lambda ()
  62.            (%%load file))))
  63.       %%load))
  64.  
  65. ;; R5RS
  66. (define call-with-input-file
  67.   (lambda (filename proc)
  68.     (let* ((port (open-input-file filename))
  69.            (res (proc port)))
  70.       (close-input-port port)
  71.       res)))
  72.  
  73. ;; R5RS
  74. (define call-with-output-file
  75.   (lambda (filename proc)
  76.     (let* ((port (open-output-file filename))
  77.            (res (proc port)))
  78.       (close-output-port port)
  79.       res)))
  80.  
  81. ;; R5RS
  82. (define with-input-from-file
  83.   (lambda (file thunk)
  84.     (let ((orig-port (current-input-port))
  85.           (thunk-port (current-input-port)))
  86.       (dynamic-wind
  87.           (lambda ()
  88.             (%%set-current-input-port! thunk-port))
  89.           (lambda ()
  90.             (let* ((port (open-input-file file))
  91.                    (res (begin
  92.                           (set! thunk-port port)
  93.                           (%%set-current-input-port! thunk-port)
  94.                           (thunk))))
  95.               (close-input-port port)
  96.               res))
  97.           (lambda ()
  98.             (%%set-current-input-port! orig-port))))))
  99.  
  100. ;; R5RS
  101. (define with-output-to-file
  102.   (lambda (file thunk)
  103.     (let ((orig-port (current-output-port))
  104.           (thunk-port (current-output-port)))
  105.       (dynamic-wind
  106.           (lambda ()
  107.             (%%set-current-output-port! thunk-port))
  108.           (lambda ()
  109.             (let* ((port (open-output-file file))
  110.                    (res (begin
  111.                           (set! thunk-port port)
  112.                           (%%set-current-output-port! thunk-port)
  113.                           (thunk))))
  114.               (close-output-port port)
  115.               res))
  116.           (lambda ()
  117.             (%%set-current-output-port! orig-port))))))
  118.